{
  for presentation of quizes
  use fmx objects
}

unit TrainPresent;

interface

uses FMX.Types,FMX.Forms,FMX.Objects,FMX.Dialogs,FMX.StdCtrls,
     System.SysUtils,System.Classes,
     Xml.XMLDoc,Xml.xmldom, Xml.XMLIntf,
     WinApi.Windows,
     APIs;

type TlsEvent = procedure(AMsg: String) of Object;

type TlsComponent = class
  private
    FParent: TForm;
    FTimer: TTimer;
  public
    lsConfig: IXMLNode;   //<component> ... </component>
    OnlsEvent: TlsEvent;
    constructor Create(AParent: TForm;AlsConfig: IXMLNode);virtual;
    destructor Destroy;virtual;
    procedure Recv(AMsg:String);virtual;
    procedure DoAction(AAction: String;ADelay: Integer);virtual;
    procedure Refresh;virtual;
    function DefaultOfVar(ANode: IXMLNode): String;
    procedure AssignVar(AVar: IXMLNode);virtual;

    procedure SetProperty(ANode: IXMLNode);virtual; //<left>100</left>

end;

type TlsTimer = class
  private
   FCheckPoint:DWord;
  public
    constructor Create;
    destructor Destroy;override;
    procedure WaitFor(Time: Integer);
    procedure SetCheckPoint;
    procedure WaitTo(ATime: Integer);
    function GetCheckPoint: DWord;
end;


type TlsText = class(TlsComponent)
  private
    FText: TText;
    FShowTimer,FHideTimer: TTimer;
    procedure TimerEvent(ASender: TObject);
  public
    constructor Create(AParent: TForm;AlsConfig: IXMLNode);override;
    destructor Destroy;override;
    procedure DoAction(AAction: String;ADelay: Integer);override;
    procedure SetProperty(ANode: IXMLNode);override;
end;
type TlsImage = class(TlsComponent)
  private
    FImage: TImage;
    FShowTimer,FHideTimer: TTimer;
    procedure TimerEvent(ASender: TObject);
  public
    constructor Create(AParent: TForm;AlsConfig: IXMLNode);override;
    destructor Destroy;override;
    procedure DoAction(AAction: String;ADelay: Integer);override;
    procedure SetProperty(ANode: IXMLNode);override;
end;

type TTrainPresent=class(TPanel)
  private
    FTrain: TXMLWrap;
    FInstance: TXMLWrap;
    FComponents: TList;
    procedure CreateComponents;
    procedure FreeComponents;
    procedure AddComponent(AlsCom: TlsComponent);
    procedure RecvEvent(AMsg: String);
    procedure FireEvent(AEvent: String);
    procedure RefreshInstance(AIndex: Integer);
    procedure RefreshComponents;
    function QuizCount: Integer;
  public
    constructor Create(AOwner: TComponent);override;
    destructor Destroy;override;
    procedure Load(ATrain: TXMLWrap);
    procedure PresentQuiz(AIndex: Integer);
end;

implementation

{ TlsComponent }

procedure TlsComponent.AssignVar(AVar: IXMLNode);
begin

end;


constructor TlsComponent.Create(AParent: TForm;AlsConfig: IXMLNode);
begin
  FParent:=AParent;
  lsConfig:=AlsConfig;
end;

function TlsComponent.DefaultOfVar(ANode: IXMLNode): String;
var Node1: IXMLNode;
begin
  Result:=ANode.ChildNodes.FindNode('var').ChildNodes.FindNode('default').NodeValue;
end;

destructor TlsComponent.Destroy;
begin
  FTimer.Free;
  inherited;
end;

procedure TlsComponent.DoAction(AAction: String;ADelay: Integer);
begin

end;


procedure TlsComponent.Recv(AMsg: String);
var t1:String;
    i: Integer;
    Node1,Node2: IXMLNode;
    Action1: String;
    Trigger1: String;
    Delay1: Integer;
begin
  Node1:=lsConfig.ChildNodes.FindNode('action');
  for i := 0 to Node1.ChildNodes.Count-1 do begin
    Node2:=Node1.ChildNodes.Get(i);
    Trigger1:=Node2.ChildNodes.FindNode('trigger').NodeValue;
    Delay1:=Node2.ChildNodes.FindNode('delay').NodeValue;
    if Trigger1=AMsg then begin
      DoAction(Node2.NodeName,Delay1);
    end;
  end;
end;

procedure TlsComponent.Refresh;
var PropertyNode1,ActionNode1,EventNode1: IXMLNode;
    Node1: IXMLNode;
    i: Integer;
begin
  PropertyNode1:=lsConfig.ChildNodes.FindNode('property');
  ActionNode1:=lsConfig.ChildNodes.FindNode('action');
  EventNode1:=lsConfig.ChildNodes.FindNode('event');

  if PropertyNode1<>nil then begin
    for i:=0 to PropertyNode1.ChildNodes.Count-1 do begin
      Node1:=PropertyNode1.ChildNodes.Get(i);
      SetProperty(Node1);
    end;
  end;
end;


procedure TlsComponent.SetProperty(ANode: IXMLNode);
begin

end;

{ TlsText }
constructor TlsText.Create(AParent: TForm;AlsConfig: IXMLNode);
begin
  inherited;
  FText:=TText.Create(FParent);
  FText.Parent:=FParent;
  FText.Visible:=False;

  FShowTimer:=TTimer.Create(AParent);
  FHideTimer:=TTimer.Create(AParent);
  FShowTimer.OnTimer:=TimerEvent;
  FHideTimer.OnTimer:=TimerEvent;
  Refresh;
end;

destructor TlsText.Destroy;
begin
  FShowTimer.Free;
  FHideTimer.Free;
  FText.Free;
  inherited;
end;

procedure TlsText.DoAction(AAction: String;ADelay: Integer);
begin
  if AAction='show' then begin
    if ADelay=0 then begin
      FShowTimer.OnTimer(FShowTimer);
    end else begin
      FShowTimer.Interval:=ADelay;
      FShowTimer.Enabled:=True;
    end;
  end else if AAction='hide' then begin
    if ADelay=0 then begin
      FHideTimer.OnTimer(FHideTimer);
    end else begin
      FHideTimer.Interval:=ADelay;
      FHideTimer.Enabled:=True;
    end;
  end;
end;

procedure TlsText.SetProperty(ANode: IXMLNode);
begin
  if ANode.NodeName='left' then begin
    FText.Position.X:=StrToInt(ANode.Text);
  end else if ANode.NodeName='top' then begin
    FText.Position.Y:=StrToInt(ANode.Text);
  end else if ANode.NodeName='width' then begin
    FText.Width:=StrToInt(ANode.Text);
  end else if ANode.NodeName='height' then begin
    FText.Height:=StrToInt(ANode.Text);
  end else if ANode.NodeName='text' then begin
    FText.Text:=ANode.Text;
  end else if ANode.NodeName='size' then begin
    FText.TextSettings.Font.Size:=StrToInt(ANode.Text);
  end;
end;

procedure TlsText.TimerEvent(ASender: TObject);
begin
  if ASender=FShowTimer then begin
    FText.Visible:=True;
    FShowTimer.Enabled:=False;
  end else if ASender=FHideTimer then begin
    FText.Visible:=False;
    FHideTimer.Enabled:=False;
  end;
end;

{ TlsImage }

constructor TlsImage.Create(AParent: TForm; AlsConfig: IXMLNode);
begin
  inherited;
  FImage:=TImage.Create(AParent);
  FImage.Parent:=AParent;
  FImage.Visible:=False;

  FShowTimer:=TTimer.Create(AParent);
  FHideTimer:=TTimer.Create(AParent);
  FShowTimer.OnTimer:=TimerEvent;
  FHideTimer.OnTimer:=TimerEvent;
  Refresh;
end;

destructor TlsImage.Destroy;
begin
  FImage.Free;
  inherited;
end;

procedure TlsImage.DoAction(AAction: String;ADelay: Integer);
begin
  if AAction='show' then begin
    if ADelay=0 then begin
      FShowTimer.OnTimer(FShowTimer);
    end else begin
      FShowTimer.Interval:=ADelay;
      FShowTimer.Enabled:=True;
    end;
  end else if AAction='hide' then begin
    if ADelay=0 then begin
      FHideTimer.OnTimer(FHideTimer);
    end else begin
      FHideTimer.Interval:=ADelay;
      FHideTimer.Enabled:=True;
    end;
  end;
end;

procedure TlsImage.SetProperty(ANode: IXMLNode);
begin
  if ANode.NodeName='left' then begin
    FImage.Position.X:=StrToInt(ANode.Text);
  end else if ANode.NodeName='top' then begin
    FImage.Position.Y:=StrToInt(ANode.Text);
  end else if ANode.NodeName='width' then begin
    FImage.Width:=StrToInt(ANode.Text);
  end else if ANode.NodeName='height' then begin
    FImage.Height:=StrToInt(ANode.Text);
  end else if ANode.NodeName='filename' then begin
    FImage.Bitmap.LoadFromFile(PathOfTrain+'\resource\'+ANode.Text);
  end;
end;

procedure TlsImage.TimerEvent(ASender: TObject);
begin
  if ASender=FShowTimer then begin
    FImage.Visible:=True;
    FShowTimer.Enabled:=False;
  end else if ASender=FHideTimer then begin
    FImage.Visible:=False;
    FHideTimer.Enabled:=False;
  end;
end;


{TlsTimer}
procedure TlsTimer.SetCheckPoint;
begin
  FCheckPoint:=GetTickCount;
end;

procedure TlsTimer.WaitFor(Time: Integer);
var T1,T2: DWord;
begin
  T1:=GetTickCount;
  while True do begin
    Application.ProcessMessages;
    T2:=GetTickCount;
    if (T2-T1)>Time then break;
  end;
end;

//wait from checkpoint to ...
procedure TlsTimer.WaitTo(ATime: Integer);
var T1: TDateTime;
begin
  while True do begin
    Application.ProcessMessages;
    T1:=GetTickCount;
    if (T1-FCheckPoint)>ATime then break;
  end;

end;

constructor TlsTimer.Create;
begin

end;

destructor TlsTimer.Destroy;
begin
  inherited;
end;

function TlsTimer.GetCheckPoint: DWord;
begin
  Result:=FCheckPoint;
end;


{ TQuizPresentForm }

procedure TTrainPresent.AddComponent(AlsCom: TlsComponent);
begin
  FComponents.Add(AlsCom);
end;

constructor TTrainPresent.Create(AOwner: TComponent);
begin
  inherited;
  FComponents:=TList.Create;
end;

procedure TTrainPresent.CreateComponents;
var i,Count1: Integer;
    Type1: String;
    Value1: String;
    lsCom1: TlsComponent;
    List1: IXMLNodeList;
    Node1: IXMLNode;
begin
  List1:=FInstance.RootNode.ChildNodes.FindNode('components').ChildNodes;
  Count1:=List1.Count;
  for i := 0 to Count1-1 do begin
    Node1:=List1.Get(i);
    Type1:=Node1.ChildNodes.FindNode('type').NodeValue;
    if Type1='text' then begin
       lsCom1:=TlsText.Create(TForm(Self),Node1);
       lsCom1.Refresh;
       AddComponent(lsCom1);
    end else if Type1='image' then begin
      lsCom1:=TlsImage.Create(TForm(Self),Node1);
      lsCom1.OnlsEvent:=RecvEvent;
      lsCom1.Refresh;
      AddComponent(lsCom1);
    end else begin
      ShowMessage('undefined type:'+Type1);
    end;
  end;
end;

destructor TTrainPresent.Destroy;
begin
  FreeComponents;
  FTrain.Free;
  inherited;
end;

procedure TTrainPresent.FireEvent(AEvent: String);
var i:Integer;
    lsCom1: TlsComponent;
begin
  for i := 0 to FComponents.Count-1 do begin
    lsCom1:=FComponents.Items[i];
    lsCom1.Recv(AEvent);
  end;
end;

procedure TTrainPresent.FreeComponents;
var i:Integer;
begin
  for i := 0 to FComponents.Count-1 do begin
    TLsComponent(FComponents.Items[i]).Free;
  end;
  FComponents.Free;
end;

procedure TTrainPresent.Load(ATrain: TXMLWrap);
begin
  FTrain:=ATrain;
  FInstance:=TXMLWrap.Create;
  FInstance.Load(FTrain.SelectNode(FTrain.RootNode,'template').XML);
  FInstance.ConvertAllValueToDefault(FInstance.RootNode);
end;

procedure TTrainPresent.PresentQuiz(AIndex: Integer);
begin
  FireEvent('unload');
  RefreshInstance(AIndex);
  RefreshComponents;
  FireEvent('load');
end;

function TTrainPresent.QuizCount: Integer;
var Node1: IXMLNode;
begin
  Node1:=FTrain.SelectNode(FTrain.RootNode,'quizes');
  Result:=Node1.ChildNodes.Count;
end;

procedure TTrainPresent.RecvEvent(AMsg: String);
begin
  FireEvent(AMsg);
end;

procedure TTrainPresent.RefreshComponents;
var i:Integer;
    Com1: TlsComponent;
begin
  for i := 0 to FComponents.Count-1 do begin
    Com1:=TlsComponent(FComponents.Items[i]);
    Com1.Refresh;
  end;
end;

procedure TTrainPresent.RefreshInstance(AIndex: Integer);
var Quizes1,Quiz1: IXMLNode;
    QuizesList1: IXMLNodeList;
    Var1: IXMLNode;
    i: Integer;
    Path1:String;
begin
  Quizes1:=FTrain.SelectNode(FTrain.RootNode,'quizes');
  QuizesList1:=Quizes1.ChildNodes;
  Quiz1:=QuizesList1.Get(AIndex);
  for i := 0 to Quiz1.ChildNodes.Count-1 do begin
    Var1:=Quiz1.ChildNodes.Get(i);
    Path1:=FTrain.PathOfVar(FTrain.SelectNode(FTrain.RootNode,'template'),Var1);
    if Path1<>'' then begin
      //ShowMessage(lsInstance.RootNode.XML);
      FInstance.AssignValueByPath(FInstance.RootNode,Path1,Var1);
      //ShowMessage(lsInstance.RootNode.XML);
    end;
  end;
end;

end.
